'REQUEST TITLE="' || NAME || '" BODY="File doesn''t belong to the*ncurrent project." BUTTON="!OK"'
/* ---------------------------- END OF YOUR CODE --------------------- */
'UNLOCK' /* VERY important: unlock GUI */
exit
SYNTAX:
SAY "Sorry, error line" SIGL ":" ERRORTEXT(RC) ":-("
'UNLOCK'
exit
/* /// "rcs_login" */
rcs_login: procedure expose CONFIG.
if ((exists("rcs:ci") = 0) | (exists("rcs:co") = 0) | (exists("rcs:rcs") = 0) | (exists("rcs:setuprcs") = 0)) then do
'REQUEST PROBLEM="File(s) missing - Please install and|configure HWRCS before you continue"'
call rcs_exit
end
'QUERY $LOGNAME VAR=LOGNAME'
if (INDEX(LOGNAME, " ") ~= 0) then do
'REQUEST PROBLEM="User name contains invalid character.*nPlease note that the user name should*nbe like a login name (*"bill*") or an*ne-mail address and not like your real*nname."'
LOGNAME = ""
end
if ((LOGNAME = "") | (LOGNAME = "0")) then do
if (VERBOSE = "TRUE") then
'REQUEST PROBLEM="Please log in before you proceed.*nIt is required that every member of your*nworkgroup logs in under a unique name.*nLogin names will be used to keep track of*nthe files used and modified by various*nmembers of your workgroup.*n" BUTTON="!OK"'
else
'REQUEST PROBLEM="Please log in before you proceed."'
call rcs_quicklogin
end
return
/* /// */
/* /// "rcs_quicklogin" */
rcs_quicklogin: procedure expose CONFIG.
'QUERY $LOGNAME VAR=LOGNAME'
if (INDEX(LOGNAME, " ") ~= 0) then do
'REQUEST PROBLEM="User name contains invalid character.*nPlease note that the user name should*nbe like a login name (*"bill*") or an*ne-mail address and not like your real*nname."'
LOGNAME = ""
end
if ((LOGNAME = "") | (LOGNAME = "0")) then do
do while ((LOGNAME = "") | (LOGNAME = "0"))
'REQUEST STRING TITLE="Login" VAR=LOGNAME'
if (RC ~= 0) then do
'UNLOCK'
exit
end
if (INDEX(LOGNAME, " ") ~= 0) then do
'REQUEST PROBLEM="Login name contains invalid character.*nPlease note that the user name should*nbe like a login name (*"bill*") or an*ne-mail address and not like your real*nname."'
LOGNAME = ""
end
else if ((LOGNAME = "") | (LOGNAME = "0")) then
'REQUEST PROBLEM="Anonymous login not supported"'
else do
'SET $LOGNAME "' || LOGNAME || '"'
'REQUEST STATUS="Logged in as ' || LOGNAME || '."'
break
end
end
end
return
/* /// */
/* /// "rcs_readcfg" */
rcs_readcfg: procedure expose CONFIG.
'QUERY PATH VAR=PATH'
/* find configuration file */
if (exists(PATH || "RCS_config") = 0) then do
if (exists(PATH || "RCS_root") = 0) then do
PATH = pragma('D')
'EXPAND NAME="' || PATH || '" VAR=PATH'
if (exists(PATH || "RCS_config") = 0) then do
if (exists(PATH || "RCS_root") = 0) then do
'REQUEST STATUS="No project in current path !"'
'REQUEST DIR TITLE="Select project directory:" VAR=PATH'
'REQUEST BODY="You have not been working on this*nproject so far. Would you like to*nbe added as new user ?" BUTTON="!ADD|_Cancel"'
if ((RC ~= 0) | (RESULT = 0)) then
call rcs_exit
else do
USER = CONFIG.CFG_USERS + 1
CONFIG.CFG_USERS = USER
CONFIG.CFG_LOGIN = USER
CONFIG.CFG_USER.USER = LOGNAME
CONFIG.CFG_WORK.USER = ""
call rcs_createworkdir USER
call rcs_savecfg
end
end
end
end
return
/* /// */
/* /// "rcs_savecfg" */
rcs_savecfg: procedure expose CONFIG.
R = open('CONFIG', CONFIG.CFG_CONFIG, 'WRITE')
if (R = 0) then
'REQUEST PROBLEM="Couldn''t save configuration file"'
else do
'QUERY DATE VAR=DATE'
R = writeln('CONFIG', "[NAME]")
R = writeln('CONFIG', CONFIG.CFG_NAME)
R = writeln('CONFIG', "")
R = writeln('CONFIG', "[PATH]")
R = writeln('CONFIG', CONFIG.CFG_PATH)
R = writeln('CONFIG', "")
R = writeln('CONFIG', "[SNAPSHOT]")
R = writeln('CONFIG', CONFIG.CFG_SNAPSHOT)
if (CONFIG.CFG_SNAPSHOT ~= "") then
R = writeln('CONFIG', "")
R = writeln('CONFIG', "[COMMENT]")
R = writeln('CONFIG', CONFIG.CFG_COMMENT)
if (CONFIG.CFG_COMMENT ~= "") then
R = writeln('CONFIG', "")
R = writeln('CONFIG', "[USER]")
if (CONFIG.CFG_USERS ~= 0) then do
do USER = 1 to CONFIG.CFG_USERS
R = writeln('CONFIG', CONFIG.CFG_USER.USER)
end
end
R = writeln('CONFIG', "")
R = writeln('CONFIG', "[WORK]")
if (CONFIG.CFG_USERS ~= 0) then do
do USER = 1 to CONFIG.CFG_USERS
R = writeln('CONFIG', CONFIG.CFG_WORK.USER)
end
end
R = writeln('CONFIG', "")
R = writeln('CONFIG', "[FILES]")
if (CONFIG.CFG_FILES ~= 0) then do
do FILE = 1 to CONFIG.CFG_FILES
R = writeln('CONFIG', CONFIG.CFG_SETUP.FILE)
end
end
R = close('CONFIG')
end
return
/* /// */
/* /// "rcs_exit" */
rcs_exit:
'UNLOCK'
exit
return
/* /// */
/* /// "rcs_createworkdir" */
rcs_createworkdir: procedure expose CONFIG.
parse arg USER
'REQUEST BODY="Please choose your working directory.*nEach member of your workgroup should*nhave a private working directory for*nthis project (on your local machine)." BUTTON="!OK"'
if (RC = 0) then do
do forever
'REQUEST DIR SAVE TITLE="Working directory..." PATH="sys:" VAR=PRJWORK'
if (RC = 0) then do
'EXPAND NAME="' || PRJWORK || '" VAR=PRJWORK'
CONFIG.CFG_WORK.USER = PRJWORK
if (exists(PRJWORK || "rcs_link") = 0) then do
if (exists(PRJWORK || "rcs_root") = 0) then do
call rcs_savelink USER
leave
end
else
'REQUEST PROBLEM="This directory is already used as*nworking directory by another user*nor for another project and can not*nbe selected again."'
end
else
leave
end
else
call rcs_exit
end
end
return
/* /// */
/* /// "rcs_savelink" */
rcs_savelink: procedure expose CONFIG.
parse arg USER
if (USER ~= 0) then do
PATH = CONFIG.CFG_WORK.USER || 'RCS_root'
R = open('CONFIG', PATH, 'WRITE')
if (R = 0) then
'REQUEST PROBLEM="Failed to save local configuration."'
